home *** CD-ROM | disk | FTP | other *** search
/ PC-X 1997 October / pcx14_9710.iso / swag / misc.swg / 0163_Percentage Bar.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-11-22  |  2.1 KB  |  103 lines
  1. {
  2. Here is my percentage bar unit, that (??Steve Rogers?? I can't quite remember
  3. now--sorry ) suggested I try a whiles back (I just got around to it).  It has
  4. been debugged for all of a hour.
  5. {**
  6.  
  7. PBar   Percentage Bar Unit   copr.1995 Brad Zavitsky
  8.  
  9. All Rights Reserved
  10. Commercial use not allowed
  11. Use at your own risk
  12.  
  13. Formulae-
  14.   Percentage    => Round(cur/max);
  15.   PBar progress => Round((cur/max) * #spaces);
  16.  
  17. ReDraw-
  18.   If set to true, the whole percentage bar is redrawn each time.
  19.   If false, it will continue were last left off
  20.  
  21. **}
  22.  
  23. unit PBar;
  24.  
  25. interface
  26.  
  27. type
  28.   BarObj = object
  29.     ReDraw : Boolean;
  30.     Spaces : Integer;
  31.     Old,
  32.     Max    : Longint;
  33.     Ch     : Char;
  34.     X,
  35.     Y,
  36.     Color  : Byte;
  37.     procedure UpDate(Cur: Longint);
  38.     procedure Init(_Spaces: Integer; _Max: Longint; _Ch: Char; _X, _Y,
  39.                    _Color: Byte; _ReDraw: Boolean);
  40.   end;
  41.  
  42. implementation
  43.  
  44. var
  45.   VS: word;
  46.  
  47. function VidSeg: Word;
  48. var
  49.   VidM: ^Byte;
  50. begin
  51.   {$iFDEF VER70}
  52.   VidM := Ptr(Seg0040,$0049);
  53.   if VidM^ = 7 then VidSeg := SegB000 else VidSeg := SegB800;
  54.   {$ELSE}
  55.   VidM := Ptr($0040,$0049);
  56.   if VidM^ = 7 then VidSeg := $B000 else VidSeg := $B800;
  57.   {$ENDiF}
  58. end;
  59.  
  60. procedure WriteChar(Ch: char; x, y, attr: byte);
  61. var
  62.   where: Word;
  63. [Abegin
  64.   Where := 160*(Y-1)+2*(X-1);
  65.   Mem[VS:Where] := Ord(Ch);
  66.   Mem[VS:Where+1] := Attr;
  67. end;
  68.  
  69. procedure BarObj.Init(_Spaces: Integer; _Max: Longint; _Ch: Char; _X, _Y,
  70.                       _Color: Byte; _ReDraw: Boolean);
  71. begin
  72.   Old := 0;
  73.   Spaces := _Spaces;
  74.   X := _X;
  75.   Y := _Y;
  76.   Color := _Color;
  77.   Ch := _Ch;
  78.   Max := _Max;
  79.   ReDraw := _ReDraw;
  80. end;
  81.  
  82. procedure BarObj.UpDate(Cur: Longint);
  83. var
  84.   Temp,
  85.   OldPos,
  86.   SpacePos: Integer;
  87. begin
  88.   SpacePos := Round((Cur/Max) * Spaces);
  89.   if ReDraw then
  90.   begin
  91.     for Temp := 0 to SpacePos-1 do WriteChar(Ch, X+Temp, Y, Color);
  92.   end else
  93.   begin
  94.     Dec(SpacePos, Old);
  95.     for Temp := 0 to SpacePos-1 do WriteChar(Ch, X+Temp+Old, Y, Color);
  96.     Inc(Old, SpacePos);
  97.   end;
  98. end;
  99.  
  100. begin
  101.   VS := VidSeg;
  102. end.
  103.